home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / borland / prbgi097.zip / PASCAL.ZIP / BGIDEMO.PAS next >
Pascal/Delphi Source File  |  1992-12-15  |  49KB  |  1,740 lines
  1. {  This program is not mine.
  2.     It was included with Turbo Pascal 6.0
  3.    and I only modified it a little  to demonstrate
  4.    features of my PRINTBGI library.
  5.    It is included here for demonstration only
  6.    and cannot be used for any other purposes. ( Could it? ).
  7.  
  8.    Original Copyright notice follows.
  9. }
  10.  
  11. { Turbo Graphics }
  12. { Copyright (c) 1985, 1990 by Borland International, Inc. }
  13.  
  14. program BGIDemo;
  15. (*
  16.   Turbo Pascal 6.0 Borland Graphics Interface (BGI) demonstration
  17.   program. This program shows how to use many features of
  18.   the Graph unit.
  19.  
  20.   NOTE: to have this demo use the IBM8514 driver, specify a
  21.   conditional define constant "Use8514" (using the {$DEFINE}
  22.   directive or Options\Compiler\Conditional defines) and then
  23.   re-compile.
  24.  
  25. *)
  26.  
  27. uses
  28.   Crt, Dos, Graph, PRTgraph,Pdrivers,UserUnit;
  29.  
  30.  
  31. const
  32.   { The five fonts available }
  33.   Fonts : array[0..4] of string[13] =
  34.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  35.  
  36.   { The five predefined line styles supported }
  37.   LineStyles : array[0..4] of string[9] =
  38.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  39.  
  40.   { The twelve predefined fill styles supported }
  41.   FillStyles : array[0..11] of string[14] =
  42.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  43.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  44.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  45.  
  46.   { The two text directions available }
  47.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  48.  
  49.   { The Horizontal text justifications available }
  50.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  51.  
  52.   { The vertical text justifications available }
  53.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  54.  
  55. var
  56.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  57.  
  58. var
  59.   GraphDriver : integer;  { The Graphics device driver }
  60.   GraphMode   : integer;  { The Graphics mode value }
  61.   (* MaxX, MaxY  : word;  *)   { The maximum resolution of the screen }
  62.       function MaxX:integer;
  63.       begin MaxX:=getmaxX; end;
  64.       function MaxY:integer;
  65.       begin MaxY:=getmaxY; end;
  66. var
  67.   ErrorCode   : integer;  { Reports any graphics errors }
  68.   (* MaxColor    : word;   *)  { The maximum color value available }
  69.       function MaxColor:integer;
  70.       begin MaxColor:=getmaxColor; end;
  71. var
  72.   OldExitProc : Pointer;  { Saves exit procedure address }
  73.  
  74. {$F+}
  75. procedure MyExitProc;
  76. var rc: integer;
  77. begin
  78.   ExitProc := OldExitProc; { Restore exit procedure address }
  79.   rc:=BGI_CloseGraph;              { Shut down the graphics system }
  80. end; { MyExitProc }
  81. {$F-}
  82.  
  83. VAR
  84.     PRTno:     word;
  85.     PRTmode:        integer;
  86.     OutName:    PathStr;
  87. Const
  88.     picwidth        : integer = 4000;
  89.     picheight     : integer =3000;
  90.     leftmargin     : integer =0;
  91.     topmargin     : integer =0;
  92.     PicRotate    : integer =0;
  93.     PicInverse    : integer =1;
  94.  
  95. {-------------------------------}
  96. Procedure ReadInt(var n: integer);
  97. {-------------------------------}
  98. var x: integer;
  99.      c: char;
  100. Begin
  101.     {$ifdef ver60 }
  102.         asm @@lp:;
  103.              mov  AH,1;   { nondestructive keyboard read }
  104.              int  $16;      { BIOS Kbd intr }
  105.              jz    @@lp;
  106.              mov  c,AL
  107.         end;
  108.         if c = ^M then
  109.         begin    (* user pressed ENTER - don't change old value *)
  110.             c := ReadKey;
  111.             writeln(n);
  112.         end
  113.         else
  114.     {$endif }
  115.     begin
  116.         {$I- }
  117.         ReadLn(x);
  118.         {$I+ }
  119.         if IOresult = 0 then n:=x;
  120.     end;
  121. End;
  122. (*-----------------------*)
  123. Procedure AskOfParameters;
  124. (*-----------------------*)
  125. var
  126.     c: char;
  127.     MAXmode    : integer;
  128.     modename        : stringPtr;
  129.     rc                : integer;
  130.     s:                PathStr;
  131. Begin
  132.     clrscr;
  133.     write ( ' Output device name [', OutName, '] ' );
  134.     ReadLn ( s ); if length(s)<>0 then OutName:=s;
  135.     rc := PRT_SetOutName ( OutName );
  136.     writeln;
  137.     writeln ( ' Choose printer mode operation' );
  138.     rc := PRT_MaxMode ( PRTno, MAXmode );
  139.     for PRTmode:=0 to MAXmode do
  140.     begin
  141.         {$V- }
  142.         rc := PRT_ModeName(PRTno,PRTmode,modename );
  143.         {$V+ }
  144.         writeln ( '        ', PRTmode:2,' - ', modename^ );
  145.     end;
  146.     PRTmode:=MAXmode+1;
  147.     repeat
  148.       c:=ReadKey;
  149.       if c=#0 then c:=ReadKey
  150.       else if ord(c)-ord('0') <= MAXmode then PRTmode := ord(c)-ord('0');
  151.     until  (PRTmode<=MAXmode) and (PRTmode>=0);
  152.  
  153.     writeln;
  154.     write ( ' Picture width in 1/1000 inch [', picwidth, '] ' );
  155.     ReadInt ( picwidth );
  156.     write ( ' Picture height in 1/1000 inch [', picheight, '] ' );
  157.     ReadInt ( picheight );
  158.  
  159.     write ( ' Top margin in 1/1000 inch [', topmargin, '] '  );
  160.     ReadInt ( topmargin );
  161.     write ( ' Left margin in 1/1000 inch [', leftmargin, '] ' );
  162.     ReadInt ( leftmargin );
  163.     write ( ' Rotate picture [', PicRotate, '] ' );
  164.     ReadInt ( PicRotate );
  165.     write ( ' Inverse picture [', PicInverse, '] ' );
  166.     ReadInt ( PicInverse );
  167.     write ( ' Screen Preview [', ScreenPreview, '] ' );
  168.     ReadInt ( ScreenPreview );
  169.     write ( ' PCX mode [', PCXmode, '] ' );
  170.     ReadInt ( PCXmode );
  171. End;
  172.  
  173. CONST
  174.     printing: boolean=false;
  175.     asking:     boolean=false;
  176. var
  177.     PRT_drv: integer;
  178.  
  179. (*---------------------------------*)
  180. Procedure DrawAndPrint ( func: DrawFuncT );
  181. (*---------------------------------*)
  182. const
  183.     Seed = 1964;
  184. var
  185.     rc  : integer;
  186.     BGIPRT_mode,mode: integer;
  187.     PicMode    : integer;
  188.     c: char;
  189.     opf: PRT_UserPrintFuncP;
  190.     imagePtr1,imagePtr2:    pointer;
  191.     s: string[7];
  192. Begin
  193.     BGIPRT_mode := 0;
  194.     repeat
  195.         asking:=false;
  196.       printing:=false;
  197.         RandSeed := Seed;
  198.         rc:=func(nil);
  199.         if asking then
  200.         begin
  201.             mode := BGI_getgraphmode(0,0);
  202.             restorecrtmode;
  203.             AskOfParameters;
  204.             BGI_setgraphmode( mode );
  205.         end;
  206.        if ( printing ) then   (* Have user pressed Ctrl-P ? *)
  207.        begin
  208.             Outmsg('Creating bit image map','Please wait',@imagePtr1);
  209.             RandSeed := Seed;
  210.             PicMode := 0;
  211.             if PicRotate<>0 then PicMode := PicMode or PRT_ROTATE;
  212.             if PicInverse<>0 then PicMode := PicMode or PRT_INVERSE;
  213.                 rc:=PRT_SetDriver ( PRTno, PRTmode,picwidth,picheight, PicMode );
  214.             rc:=PRT_SetMargins ( leftmargin, topmargin );
  215.             opf:=PRT_SetUserPrintFunc(PRT_ScreenPreview);
  216.             PRT_HaltPrinting := 0;      { reset ctrl-break flag }
  217.             rc:=PRT_PrintBGI ( PRT_drv, BGIPRT_mode, PathToDriver, func, nil );
  218.            if ( rc<>0 ) then
  219.            begin
  220.                 Str(rc:3,s);
  221.                 OutMsg (' error code '+s, PRT_errormsg(rc), @imagePtr2 );
  222.                 c:=ReadKey; while KeyPressed do c:=ReadKey;
  223.                 CloseOutMsg ( @imagePtr2 );
  224.             end;
  225.             CloseOutmsg( @imagePtr1);
  226.         end;
  227.     until ( not asking  and  not printing );
  228.  
  229. End;
  230.  
  231. (*-----------------*)
  232. Procedure  PRT_Initialize;
  233. (*-----------------*)
  234. var
  235.     PRTname:        stringPtr;
  236.     MaxPrinterNo: integer;
  237.     rc:            integer;
  238.     c:                char;
  239. Begin
  240.     OutName := 'PRN';
  241.     { rc:=PRT_LinkDrivers; }   { link printers definitions }
  242.     rc:=PRT_ReadDrivers(getenv('BGIPATH'),'Printers.Def');
  243.     if rc<>0 then
  244.     begin
  245.         writeln ('Sorry - I can''t find drivers defintion file' );
  246.         halt(12);
  247.     end;
  248.     MaxPrinterNo := PRT_MaxDriver;
  249.     clrscr;
  250.     writeln;
  251.     writeln ( 'This is a sample program (developed from Borland''s BGIDEMO.PAS)' );
  252.     writeln ( 'demonstrating some of the features of PrintBGI toolkit' );
  253.     writeln ( 'Hope you''ll find it usefull (the whole package not this program,' );
  254.     writeln ( 'of course).' );
  255.    writeln;
  256.    writeln ( 'Please, let me know if this program does not work with your printer.');
  257.    writeln ( 'To contact me write to RESZTAK@PLUMCS11.bitnet');
  258.     writeln;
  259.     writeln ( '              Press any key to continue');
  260.     c:=ReadKey; while KeyPressed do c:=ReadKey;
  261.     clrscr;
  262.  
  263.     writeln ( '    Choose printer type' );
  264.     writeln;
  265.     for PRTno:=1 to MaxPrinterNo do
  266.     begin
  267.         rc := PRT_DriverName(PRTno,PRTname);
  268.         writeln ( '        ', PRTno, ' - ', PRTname^ );
  269.     end;
  270.     repeat
  271.         Readln(PRTno);
  272.     until ( (PRTno<=MaxPrinterNo) and (PRTno>0) );
  273.  
  274.     clrscr;
  275.     PRT_drv := Detect; { needed if you don't want to link BitImage driver }
  276.     PRT_drv := PRT_installuserdriver ( 'BitImage', NIL );
  277.     rc := PRT_registerbgidriver ( @BitImage );
  278.  
  279.     AskOfParameters;
  280.     writeln;
  281.     writeln ( ' You will be able to change above parameters by pressing Ctrl-C.' );
  282.     writeln;
  283.     writeln ( '                   Press any key to continue');
  284.     c:=ReadKey;while KeyPressed do c:=ReadKey;
  285. End;
  286.  
  287.  
  288.  
  289. proced